home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 376-400 / disk_386 / xlispstat / src2.lzh / XLisp-Stat / xsiviewwin.c < prev    next >
C/C++ Source or Header  |  1990-10-04  |  8KB  |  320 lines
  1. /* xsiviewwin - XLISP interface to IVIEW dynamic graphics package.     */
  2. /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
  3. /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
  4. /* You may give out copies of this software; for conditions see the    */
  5. /* file COPYING included with this distribution.                       */
  6.  
  7. #include <string.h>
  8. #include "xlisp.h"
  9. #include "osdef.h"
  10. #ifdef ANSI
  11. #include "xlproto.h"
  12. #include "xlsproto.h"
  13. #include "iviewproto.h"
  14. #include "Stproto.h"
  15. #include "osproto.h"
  16. #else
  17. #include "xlfun.h"
  18. #include "xlsfun.h"
  19. #include "iviewfun.h"
  20. #include "Stfun.h"
  21. #include "osfun.h"
  22. #endif ANSI
  23. #include "xlsvar.h"
  24.  
  25. #define IVIEW_WINDOW_TITLE  "Graph Window"
  26. #ifdef MACINTOSH
  27. #define IVIEW_WINDOW_LEFT 10
  28. #define IVIEW_WINDOW_TOP 40
  29. #define IVIEW_WINDOW_WIDTH  250
  30. #define IVIEW_WINDOW_HEIGHT 250
  31. #else
  32. #define IVIEW_WINDOW_LEFT 50
  33. #define IVIEW_WINDOW_TOP 50
  34. #define IVIEW_WINDOW_WIDTH  400
  35. #define IVIEW_WINDOW_HEIGHT 400
  36. #endif
  37.  
  38. /**************************************************************************/
  39. /**                                                                      **/
  40. /**                       Window Creation Functions                      **/
  41. /**                                                                      **/
  42. /**************************************************************************/
  43.  
  44. /* :ISNEW message for IVIEW-WINDOW-CLASS */
  45. LVAL iview_window_isnew()
  46. {
  47.   LVAL object = xlgaobject();
  48.   int show = xsboolkey(sk_show, TRUE);
  49.   
  50.   object_isnew(object);
  51.   initialize_graph_window(object);
  52.   if (show) send_message(object, sk_allocate);
  53.   return(object);
  54. }
  55.  
  56. /* :ALLOCATE message for IVIEW-WINDOW-CLASS */
  57. LVAL iview_window_allocate()
  58. {
  59.   LVAL object;
  60.   IVIEW_WINDOW w;
  61.   
  62.   object = xlgaobject();
  63.   
  64.   w = IViewWindowNew(object, TRUE);
  65.   /* use StShowWindow to show (map) window but NOT send :resize or :redraw */
  66.   if (xsboolkey(sk_show, TRUE)) StShowWindow(w);
  67.   
  68.   return(object);
  69. }
  70.  
  71. void StGWGetAllocInfo(object, title, left, top, width, height, goAway)
  72.     LVAL object;
  73.     char **title;
  74.     int *left, *top, *width, *height, *goAway;
  75. {
  76.   LVAL window_title;
  77.   
  78.   if (slot_value(object, s_hardware_address) != NIL)
  79.       send_message(object, sk_dispose);
  80.   
  81.   window_title = slot_value(object, s_title);
  82.   if (!stringp(window_title)) {
  83.       window_title = newstring(strlen(IVIEW_WINDOW_TITLE) + 1);
  84.       strcpy((char *) getstring(window_title), IVIEW_WINDOW_TITLE);
  85.       set_slot_value(object, s_title, window_title);
  86.   }
  87.   *title = (char *) getstring(window_title);
  88.   
  89.   *left = IVIEW_WINDOW_LEFT;
  90.   *top = IVIEW_WINDOW_TOP;
  91.   *width = IVIEW_WINDOW_WIDTH;
  92.   *height = IVIEW_WINDOW_HEIGHT;
  93.   get_window_bounds(object, left, top, width, height);
  94.   
  95.   *goAway = slot_value(object, s_go_away) != NIL;
  96. }
  97.  
  98. void StGWObDoClobber(object)
  99.   LVAL object;
  100. {
  101.   standard_hardware_clobber(object);
  102. }
  103.  
  104. void StGWObResize(object)
  105.   LVAL object;
  106. {
  107.   send_message(object, sk_resize);
  108. }
  109.  
  110. void StGWObRedraw(object)
  111.     LVAL object;
  112. {
  113.   send_message(object, sk_redraw);
  114. }
  115.     
  116.  
  117. /* idle action. incall is used to detect longjmp's on errors and to    */
  118. /* turn off idle calling if the call is generating an error.           */
  119. void StGWObDoIdle(object)
  120.     LVAL object;
  121. {
  122.   static int incall = FALSE;
  123.   
  124.   if (incall) {
  125.     StGWSetIdleOn(StGWObWinInfo(object), FALSE);
  126.     incall = FALSE;
  127.     return;
  128.   }
  129.   else {
  130.     incall = TRUE;
  131.     send_message(object, sk_do_idle);
  132.     incall = FALSE;
  133.   }
  134. }
  135.  
  136. void StGWObDoMouse(object, x, y, type, mods)
  137.      LVAL object;
  138.      int x, y;
  139.      MouseEventType type;
  140.      MouseClickModifier mods;
  141. {
  142.   LVAL Lx, Ly, argv[6];
  143.   int extend, option;
  144.   
  145.   xlstkcheck(2);
  146.   xlsave(Lx);
  147.   xlsave(Ly);
  148.   argv[0] = object;
  149.   argv[2] = Lx = cvfixnum((FIXTYPE) x);
  150.   argv[3] = Ly = cvfixnum((FIXTYPE) y);
  151.  
  152.   if (type == MouseClick) {
  153.     extend = ((int) mods) % 2;
  154.     option = ((int) mods) / 2;
  155.     argv[1] = sk_do_click;
  156.     argv[4] = (extend) ? s_true : NIL;
  157.     argv[5] = (option) ? s_true : NIL;
  158.     xscallsubrvec(xmsend, 6, argv);
  159.   }
  160.   else {
  161.     argv[1] = sk_do_motion;
  162.     xscallsubrvec(xmsend, 4, argv);
  163.   }
  164.   xlpopn(2);
  165. }
  166.  
  167. void StGWObDoKey(object, key, shift, opt)
  168.     LVAL object;
  169.     unsigned char key;
  170.     int shift, opt;
  171. {
  172.   LVAL argv[5], ch;
  173.   
  174.   xlsave1(ch);
  175.   ch = cvchar(key);
  176.   argv[0] = object;
  177.   argv[1] = sk_do_key;
  178.   argv[2] = ch;
  179.   argv[3] = shift ? s_true : NIL;
  180.   argv[4] = opt ? s_true : NIL;
  181.   xscallsubrvec(xmsend, 5, argv);
  182.   xlpop();
  183. }
  184.   
  185. StGWWinInfo *StGWObWinInfo(object)
  186.     LVAL object;
  187. {
  188.   LVAL internals = slot_value(object, s_internals);
  189.   
  190.   if (! consp(internals) || ! adatap(car(internals)) 
  191.       || getadaddr(car(internals)) == nil) 
  192.     xlfail("bad internal data");
  193.   else return((StGWWinInfo *) getadaddr(car(internals))); /* cast changed JKL */
  194. }
  195.  
  196. void initialize_graph_window(object)
  197.     LVAL object;
  198. {
  199.   LVAL internals, value;
  200.   int v, width, height, size;
  201.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  202.   ColorCode bc,dc; /* added JKL */
  203.   
  204.   internals = newadata(StGWWinInfoSize(), 1, FALSE);
  205.   set_slot_value(object, s_internals, consa(internals));
  206.   StGWInitWinInfo(object);
  207.   
  208.   gwinfo = StGWObWinInfo(object);
  209.   if (gwinfo == nil) return;
  210.   
  211.   StGWSetObject(gwinfo, object);
  212.  
  213.   if (slot_value(object, s_black_on_white) == NIL) {
  214.     bc = StGWBackColor(gwinfo);         /* this seems better for color */
  215.     dc = StGWDrawColor(gwinfo);         /* machines - 0 and 1 are not  */
  216.     StGWSetDrawColor(gwinfo, bc);       /* the default draw and back   */
  217.     StGWSetBackColor(gwinfo, dc);       /* colors on the Amiga   JKL   */
  218.   }
  219.   
  220.   StGetScreenSize(&width, &height);
  221.   size = (width > height) ? width : height;
  222.   if ((value = slot_value(object, s_has_h_scroll)) != NIL) {
  223.     v =  (fixp(value)) ? getfixnum(value) : size;
  224.     StGWSetHasHscroll(gwinfo, TRUE, v);
  225.   }
  226.   if ((value = slot_value(object, s_has_v_scroll)) != NIL) {
  227.     v =  (fixp(value)) ? getfixnum(value) : size;
  228.     StGWSetHasVscroll(gwinfo, TRUE, v);
  229.   }
  230. }
  231.  
  232. LVAL xsiview_window_update()
  233. {
  234. #if defined MACINTOSH|AMIGA
  235.   LVAL object;
  236.   int resized;
  237.   
  238.   object = xlgaobject();
  239.   resized = (xlgetarg() != NIL);
  240.   xllastarg();
  241.   
  242.   graph_update_action(StGWObWinInfo(object), resized);
  243. #endif MACINTOSH
  244.   return(NIL);
  245. }
  246.  
  247. LVAL xsiview_window_activate()
  248. {
  249. #ifdef MACINTOSH
  250.   LVAL object, menu;
  251.   int active;
  252.  
  253.   object = xlgaobject();
  254.   active = (xlgetarg() != NIL);
  255.   xllastarg();
  256.   
  257.   graph_activate_action(StGWObWinInfo(object), active);
  258.   menu = slot_value(object, s_menu);
  259.   if (menu_p(menu)) {
  260.     if (active) send_message(menu, sk_install);
  261.     else send_message(menu, sk_remove);
  262.   }
  263. #endif MACINTOSH
  264.   return(NIL);
  265. }
  266.  
  267. /**************************************************************************/
  268. /**                                                                      **/
  269. /**                     Idle Installation Functions                      **/
  270. /**                                                                      **/
  271. /**************************************************************************/
  272.  
  273. LVAL iview_window_idle_on()
  274. {
  275.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  276.   int on, set = FALSE;
  277.   
  278.   gwinfo = StGWObWinInfo(xlgaobject());
  279.   if (gwinfo == nil) return(NIL);
  280.   
  281.   if (moreargs()) {
  282.     set = TRUE;
  283.     on = (xlgetarg() != NIL) ? TRUE : FALSE;
  284.   }
  285.   xllastarg();
  286.  
  287.   if (set) StGWSetIdleOn(gwinfo, on);
  288.   return((StGWIdleOn(gwinfo)) ? s_true : NIL);
  289. }
  290.  
  291. /**************************************************************************/
  292. /**                                                                      **/
  293. /**                 Menu Installation and Access Functions               **/
  294. /**                                                                      **/
  295. /**************************************************************************/
  296. /* in headers JKL
  297. extern LVAL get_menu_by_hardware();
  298. extern IVIEW_MENU get_hardware_menu();
  299. */
  300. LVAL iview_window_menu()
  301. {
  302.   LVAL object, menu;
  303.   int set = FALSE;
  304.   
  305.   object = xlgaobject();
  306.   if (moreargs()) {
  307.     set = TRUE;
  308.     menu = xlgetarg();
  309.   }
  310.   xllastarg();
  311.  
  312.   if (set) {
  313.     if (menu_p(menu)) set_slot_value(object, s_menu, menu);
  314.     else if (menu == NIL) set_slot_value(object, s_menu, NIL);
  315.     else xlerror("not a menu", menu);
  316.   }
  317.   
  318.   return(slot_value(object, s_menu));
  319. }
  320.